home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / VBASIC / VBDLH02.ZIP / VBDE_SRC.ZIP / VBDEDIR.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-03-08  |  13.0 KB  |  370 lines
  1. VERSION 2.00
  2. Begin Form frmDirList 
  3.    BackColor       =   &H8000000F&
  4.    BorderStyle     =   3  'Fixed Double
  5.    Caption         =   "Directory"
  6.    ClientHeight    =   5385
  7.    ClientLeft      =   465
  8.    ClientTop       =   1770
  9.    ClientWidth     =   5550
  10.    Height          =   5760
  11.    Left            =   420
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   5385
  16.    ScaleWidth      =   5550
  17.    Top             =   1440
  18.    Width           =   5640
  19.    Begin CheckBox chkDir 
  20.       Caption         =   "Over&write"
  21.       Height          =   375
  22.       Index           =   1
  23.       Left            =   3240
  24.       TabIndex        =   8
  25.       Top             =   2520
  26.       Value           =   1  'Checked
  27.       Width           =   2055
  28.    End
  29.    Begin Frame fraDirList 
  30.       Caption         =   "&Type"
  31.       Height          =   1335
  32.       Left            =   3240
  33.       TabIndex        =   9
  34.       Top             =   3000
  35.       Width           =   2055
  36.       Begin OptionButton optFile 
  37.          Caption         =   "All Files"
  38.          Height          =   375
  39.          Index           =   1
  40.          Left            =   120
  41.          TabIndex        =   11
  42.          Top             =   840
  43.          Width           =   1335
  44.       End
  45.       Begin OptionButton optFile 
  46.          Caption         =   "Selected Files"
  47.          Height          =   375
  48.          Index           =   0
  49.          Left            =   120
  50.          TabIndex        =   10
  51.          Top             =   360
  52.          Value           =   -1  'True
  53.          Width           =   1335
  54.       End
  55.    End
  56.    Begin CheckBox chkDir 
  57.       Caption         =   "&Use Directories"
  58.       Height          =   375
  59.       Index           =   0
  60.       Left            =   3240
  61.       TabIndex        =   7
  62.       Top             =   2040
  63.       Value           =   1  'Checked
  64.       Width           =   2055
  65.    End
  66.    Begin CommandButton cmdDirList 
  67.       Caption         =   "&Make Dir..."
  68.       Height          =   495
  69.       Index           =   3
  70.       Left            =   3240
  71.       TabIndex        =   12
  72.       Top             =   4560
  73.       Width           =   2055
  74.    End
  75.    Begin CommandButton cmdDirList 
  76.       Caption         =   "&Help"
  77.       Height          =   495
  78.       Index           =   2
  79.       Left            =   3240
  80.       TabIndex        =   6
  81.       Top             =   1440
  82.       Width           =   2055
  83.    End
  84.    Begin CommandButton cmdDirList 
  85.       Cancel          =   -1  'True
  86.       Caption         =   "&Cancel"
  87.       Height          =   495
  88.       Index           =   1
  89.       Left            =   3240
  90.       TabIndex        =   5
  91.       Top             =   840
  92.       Width           =   2055
  93.    End
  94.    Begin CommandButton cmdDirList 
  95.       Caption         =   "&OK"
  96.       Default         =   -1  'True
  97.       Height          =   495
  98.       Index           =   0
  99.       Left            =   3240
  100.       TabIndex        =   4
  101.       Top             =   240
  102.       Width           =   2055
  103.    End
  104.    Begin DriveListBox drvUnpack 
  105.       Height          =   390
  106.       Left            =   240
  107.       TabIndex        =   3
  108.       Top             =   4680
  109.       Width           =   2775
  110.    End
  111.    Begin DirListBox dirUnpack 
  112.       Height          =   3330
  113.       Left            =   240
  114.       TabIndex        =   1
  115.       Top             =   960
  116.       Width           =   2775
  117.    End
  118.    Begin Label lblPath 
  119.       AutoSize        =   -1  'True
  120.       BackColor       =   &H8000000F&
  121.       BackStyle       =   0  'Transparent
  122.       Caption         =   "Path"
  123.       Height          =   270
  124.       Left            =   240
  125.       TabIndex        =   13
  126.       Top             =   600
  127.       Width           =   420
  128.    End
  129.    Begin Label lblDirlist 
  130.       AutoSize        =   -1  'True
  131.       BackColor       =   &H8000000F&
  132.       BackStyle       =   0  'Transparent
  133.       Caption         =   "Dri&ve:"
  134.       Height          =   195
  135.       Index           =   1
  136.       Left            =   240
  137.       TabIndex        =   2
  138.       Top             =   4320
  139.       Width           =   525
  140.    End
  141.    Begin Label lblDirlist 
  142.       AutoSize        =   -1  'True
  143.       BackColor       =   &H8000000F&
  144.       BackStyle       =   0  'Transparent
  145.       Caption         =   "&Directory:"
  146.       Height          =   195
  147.       Index           =   0
  148.       Left            =   240
  149.       TabIndex        =   0
  150.       Top             =   240
  151.       Width           =   840
  152.    End
  153. '===================================================
  154. 'Sample VB program using UNLHA.DLL
  155. 'VBDeDir.Frm    (frmDirList)
  156. 'Original: Niiyama(HEROPA) SGV00153@niftyserve.or.jp
  157. 'English : Hitoshi Ozawa   h_ozawa@bekkoame.or.jp
  158. '===================================================
  159. Option Explicit
  160.     Dim mstrUnpackDir As String
  161.     Const BTN_OK = 0
  162.     Const BTN_CANCEL = 1
  163.     Const BTN_HELP = 2
  164.     Const BTN_MKDIR = 3
  165. Sub cmdDirList_Click (Index As Integer)
  166.     Dim intReturnCode As Integer    'WinHelp return codel
  167.     Select Case Index
  168.     Case BTN_OK
  169.     If Right$(mstrUnpackDir$, 1) <> "\" Then mstrUnpackDir$ = mstrUnpackDir$ & "\"
  170.     gstrUnpackDir$ = mstrUnpackDir$
  171.     gintfUnpackCancel% = False
  172.     gintbDirFlag% = CInt(chkDir(0).Value) * (-1)
  173.     gintbOverWriteFalg% = CInt(chkDir(1).Value) * (-1)
  174.     Me.Hide
  175.     Case BTN_CANCEL
  176.     gstrUnpackDir$ = ""
  177.     gintfUnpackCancel% = True
  178.     Unload Me
  179.     Case BTN_HELP
  180.     intReturnCode% = WinHelp(frmArchive.hWnd, gstrHelpFile$, HELP_CONTEXT, ByVal HLP_DLGCHOOSEDIR&)
  181.     Case BTN_MKDIR
  182.     Call MakeDir
  183.     End Select
  184. End Sub
  185. Sub dirUnpack_Change ()
  186.     mstrUnpackDir$ = dirUnpack.Path
  187.     If Me.TextWidth(mstrUnpackDir$) >= dirUnpack.Width Then
  188.     lblPath.Caption = GetShortName(mstrUnpackDir$)
  189.     Else
  190.     lblPath.Caption = mstrUnpackDir$
  191.     End If
  192. End Sub
  193. Sub drvUnpack_Change ()
  194.     Dim strErrMsg       As String
  195.     Dim intType         As Integer
  196.     Dim intReturnCode   As Integer
  197.     On Error GoTo ErrDriveChange:
  198.     dirUnpack.Path = drvUnpack.Drive
  199.     Exit Sub
  200. ErrDriveChange:
  201.     Select Case Err
  202.     Case 68 'Device not ready
  203.     strErrMsg$ = "Drive" & drvUnpack.Drive & " is not ready."
  204.     intType% = MB_RETRYCANCEL Or MB_ICONEXCLAMATION
  205.     intReturnCode% = MsgBox(strErrMsg$, intType%, APP_CAPTION)
  206.     If intReturnCode% = IDRETRY Then
  207.         Resume
  208.     End If
  209.     Case Else
  210.     MsgBox "Unpredicted error. Err:" & Err
  211.     End Select
  212.     'Return drive
  213.     drvUnpack.Drive = dirUnpack.Path
  214.     Resume Next
  215. End Sub
  216. Sub Form_Load ()
  217.     Dim intLoopCount As Integer
  218.     Dim intbSelectFlag As Integer
  219.     Call SetControlPosition
  220.     Call SetControl3D
  221.     'Check if List box was selected
  222.     intbSelectFlag% = False
  223.     For intLoopCount% = 0 To frmArchive!lstArchive.ListCount - 1
  224.     If frmArchive!lstArchive.Selected(intLoopCount%) = True Then
  225.         intbSelectFlag% = True
  226.     End If
  227.     Next intLoopCount%
  228.     'if selected
  229.     If intbSelectFlag% = True Then
  230.     optFile(0).Value = True
  231.     optFile(1).Value = False
  232.     'if not selected
  233.     Else
  234.     optFile(1).Value = True
  235.     optFile(0).Value = False
  236.     optFile(1).Enabled = False
  237.     optFile(0).Enabled = False
  238.     fraDirList.Enabled = False
  239.     End If
  240.     'Recurse Directory option
  241.     If gintbDirFlag% = True Then
  242.     chkDir(0).Value = CHECKED
  243.     Else
  244.     chkDir(0).Value = UNCHECKED
  245.     End If
  246.     'Overwrite option
  247.     If gintbOverWriteFalg% = True Then
  248.     chkDir(1).Value = CHECKED
  249.     Else
  250.     chkDir(1).Value = UNCHECKED
  251.     End If
  252.     mstrUnpackDir$ = LCase$(gstrUnpackDir$)
  253.     dirUnpack.Path = mstrUnpackDir$
  254.     drvUnpack.Drive = mstrUnpackDir$
  255.     If Me.TextWidth(mstrUnpackDir$) >= dirUnpack.Width Then
  256.     lblPath.Caption = GetShortName(mstrUnpackDir$)
  257.     Else
  258.     lblPath.Caption = mstrUnpackDir$
  259.     End If
  260.     Call SetChildWindowPos(frmArchive, Me)
  261.     Call DeleteSwitchTo(Me)
  262.     Me.Icon = frmArchive.Icon
  263.     Me.Caption = APP_CAPTION & " - " & Me.Caption
  264.     'If help file does not exist
  265.     If gstrHelpFile$ = "" Then cmdDirList(BTN_HELP).Enabled = False
  266. End Sub
  267. 'display InputBox and create directory based on input
  268. Sub MakeDir ()
  269.     Dim strReturnStrings    As String   'InputBox return code
  270.     Dim strMsg              As String   'MsgBox
  271.     Dim intType             As Integer  'MsgBox
  272.     Dim strMakePath         As String   'make directory
  273.     strMsg$ = "Please enter directory name below " & dirUnpack.Path & "."
  274.     strReturnStrings$ = Trim(InputBox(strMsg$, "Make Dir"))
  275.     If strReturnStrings$ = "" Then Exit Sub
  276.     On Error GoTo ErrInput
  277.     strMakePath$ = dirUnpack.Path
  278.     If Right$(strMakePath$, 1) <> "\" Then strMakePath$ = strMakePath$ & "\"
  279.     MkDir strMakePath$ & strReturnStrings$
  280.     dirUnpack.Path = strMakePath$ & strReturnStrings$
  281. Exit Sub
  282. ErrInput:
  283.     Select Case Err
  284.     Case 75 'directory already exists
  285.     strMsg$ = strReturnStrings$ & " already exists. Extract files there?"
  286.     intType% = MB_YESNO Or MB_ICONQUESTION
  287.     If MsgBox(strMsg$, intType%, APP_CAPTION) = IDYES Then
  288.         Resume Next
  289.     End If
  290.     Case Else
  291.     strMsg$ = "Failed to make directory " & strReturnStrings$ & ". MakeDirErr: " & Err
  292.     MsgBox strMsg, MB_ICONEXCLAMATION, APP_CAPTION
  293.     Exit Sub
  294.     End Select
  295. Resume
  296. End Sub
  297. 'draw 3D objects about controls
  298. Sub SetControl3D ()
  299.     Me.AutoRedraw = True
  300.     Call Draw3DControl(dirUnpack)
  301.     Call Draw3DControl(drvUnpack)
  302.     Call Draw3DForm(Me)
  303.     Me.AutoRedraw = False
  304. End Sub
  305. 'set control position
  306. Sub SetControlPosition ()
  307.     Const DLG_SPACE = 4
  308.     dirUnpack.Width = Me.TextWidth(String$(15, "A"))
  309.     lblDirList(0).Left = 2 * DLG_SPACE * Screen.TwipsPerPixelX
  310.     lblDirList(0).Top = 2 * DLG_SPACE * Screen.TwipsPerPixelY
  311.     lblPath.Left = lblDirList(0).Left
  312.     lblPath.Top = lblDirList(0).Top + lblDirList(0).Height + DLG_SPACE * Screen.TwipsPerPixelY
  313.     cmdDirList(0).Left = dirUnpack.Left + dirUnpack.Width + 2 * DLG_SPACE * Screen.TwipsPerPixelX
  314.     cmdDirList(0).Top = lblDirList(0).Top
  315.     cmdDirList(0).Width = Me.TextWidth("Dir
  316. (M)...") + 3 * DLG_SPACE * Screen.TwipsPerPixelX
  317.     cmdDirList(0).Height = Me.TextHeight("OK") + 3 * DLG_SPACE * Screen.TwipsPerPixelY
  318.     cmdDirList(1).Left = cmdDirList(0).Left
  319.     cmdDirList(1).Top = cmdDirList(0).Top + cmdDirList(0).Height + DLG_SPACE * Screen.TwipsPerPixelY
  320.     cmdDirList(1).Width = cmdDirList(0).Width
  321.     cmdDirList(1).Height = cmdDirList(0).Height
  322.     cmdDirList(2).Left = cmdDirList(1).Left
  323.     cmdDirList(2).Top = cmdDirList(1).Top + cmdDirList(1).Height + DLG_SPACE * Screen.TwipsPerPixelY
  324.     cmdDirList(2).Width = cmdDirList(1).Width
  325.     cmdDirList(2).Height = cmdDirList(1).Height
  326.     chkDir(0).Left = cmdDirList(2).Left
  327.     chkDir(0).Top = cmdDirList(2).Top + cmdDirList(2).Height + DLG_SPACE * Screen.TwipsPerPixelY
  328.     chkDir(0).Width = cmdDirList(2).Width
  329.     chkDir(0).Height = Me.TextHeight("Dir
  330. ") + DLG_SPACE * Screen.TwipsPerPixelY
  331.     chkDir(0).BackColor = Me.BackColor
  332.     chkDir(1).Left = chkDir(0).Left
  333.     chkDir(1).Top = chkDir(0).Top + chkDir(0).Height + DLG_SPACE * Screen.TwipsPerPixelY
  334.     chkDir(1).Width = chkDir(0).Width
  335.     chkDir(1).Height = chkDir(0).Height
  336.     chkDir(1).BackColor = Me.BackColor
  337.     fraDirList.Left = chkDir(1).Left
  338.     fraDirList.Top = chkDir(1).Top + chkDir(1).Height + DLG_SPACE * Screen.TwipsPerPixelY
  339.     fraDirList.Width = chkDir(1).Width
  340.     fraDirList.Height = 4 * Me.TextHeight("
  341. ") + 3 * DLG_SPACE * Screen.TwipsPerPixelY
  342.     fraDirList.BackColor = Me.BackColor
  343.     optFile(0).Left = 2 * DLG_SPACE * Screen.TwipsPerPixelX
  344.     optFile(0).Top = Me.TextHeight("
  345. ") + 2 * DLG_SPACE * Screen.TwipsPerPixelY
  346.     optFile(0).Width = fraDirList.Width - 4 * DLG_SPACE * Screen.TwipsPerPixelX
  347.     optFile(0).Height = Me.TextHeight("
  348. ") + DLG_SPACE * Screen.TwipsPerPixelY
  349.     optFile(0).BackColor = Me.BackColor
  350.     optFile(1).Left = optFile(0).Left
  351.     optFile(1).Top = optFile(0).Top + optFile(0).Height + DLG_SPACE * Screen.TwipsPerPixelY
  352.     optFile(1).Width = optFile(0).Width
  353.     optFile(1).Height = optFile(0).Height
  354.     optFile(1).BackColor = Me.BackColor
  355.     cmdDirList(3).Left = fraDirList.Left
  356.     cmdDirList(3).Top = fraDirList.Top + fraDirList.Height + DLG_SPACE * Screen.TwipsPerPixelY
  357.     cmdDirList(3).Width = cmdDirList(2).Width
  358.     cmdDirList(3).Height = cmdDirList(2).Height
  359.     drvUnpack.Left = lblDirList(0).Left
  360.     drvUnpack.Top = cmdDirList(3).Top + cmdDirList(3).Height - drvUnpack.Height
  361.     drvUnpack.Width = dirUnpack.Width
  362.     lblDirList(1).Left = drvUnpack.Left
  363.     lblDirList(1).Top = drvUnpack.Top - lblDirList(1).Height - DLG_SPACE * Screen.TwipsPerPixelY
  364.     dirUnpack.Left = lblDirList(0).Left
  365.     dirUnpack.Top = lblPath.Top + lblPath.Height + DLG_SPACE * Screen.TwipsPerPixelY
  366.     dirUnpack.Height = lblDirList(1).Top - dirUnpack.Top - DLG_SPACE * Screen.TwipsPerPixelY
  367.     Me.Width = cmdDirList(3).Left + cmdDirList(3).Width + (2 * DLG_SPACE + 2 * gintCXDLGFRAME + 2) * Screen.TwipsPerPixelX
  368.     Me.Height = cmdDirList(3).Top + cmdDirList(3).Height + (2 * DLG_SPACE + 2 * gintCYDLGFRAME + gintCYCAPTION + 2) * Screen.TwipsPerPixelY
  369. End Sub
  370.